Bar Chart

source("../lib/plot-element.R")

并列和堆叠, Group and Stack

Animals <- c("giraffes", "orangutans", "monkeys")
SF_Zoo <- c(20, 14, 23)
LA_Zoo <- c(12, 18, 29)
bar_data <- data.table(Animals, SF_Zoo, LA_Zoo)

p0 <- create_canvas(data = bar_data, x = ~Animals) %>%
  config(mathjax = "cdn") %>%
  add_bars(
    y = ~SF_Zoo,
    name = "SF Zoo"
  ) %>%
  add_bars(
    y = ~LA_Zoo,
    name = "LA Zoo"
  ) %>%
  layout(
    xaxis = list(title = "Animals"),
    yaxis = list(title = "Count")
  )

p <- p0 %>%
  layout(barmode = "group")
p

p <- p0 %>%
  layout(barmode = "stack")
p

条上显示数值/文本

x <- c("Product A", "Product B", "Product C")
y <- c(20, 14, 23)
y2 <- c(16, 12, 27)
text <- c("27% market share", "24% market share", "19% market share")
bar_data <- data.table(x, y, y2, text)

p0 <- create_canvas(
  data = bar_data, x = ~x,
  # color = I("black"),
  # I('...') 的定义会规定所有颜色，不用把marker的color, line的color等全部写一遍
  marker = list(
    color = "rgb(158,202,225)",
    line = list(
      color = "rgb(8,48,107)",
      width = 1.5
    )
  )
) %>%
  layout(
    title = list(
      text = "January 2013 Sales Report",
      pad = list(t = 40)
    ),
    legend = list(
      bgcolor = "white",
      xanchor = "left"
    )
  ) %>%
  config(mathjax = "cdn")

p <- p0 %>%
  add_bars(y = ~y, text = ~text)
p

p <- p0 %>%
  add_bars(y = ~y, text = ~y)
p

p <- p0 %>%
  add_bars(y = ~y, text = ~y, name = "y1") %>%
  add_bars(y = ~y2, text = ~y2, name = "y2") %>%
  layout(barmode = "group")
p

轴刻度标签倾斜, Rotated Labels

x <- c(
  "January", "February", "March", "April", "May", "June",
  "July", "August", "September", "October", "November", "December"
)
y1 <- c(20, 14, 25, 16, 18, 22, 19, 15, 12, 16, 14, 17)
y2 <- c(19, 14, 22, 14, 16, 19, 15, 14, 10, 12, 12, 16)
data <- data.table(x, y1, y2)

# The default order will be alphabetized unless specified as below:
data$x <- factor(data$x, levels = data[["x"]])

p0 <- create_canvas(data = data, x = ~x) %>%
  layout(
    legend = list(
      bgcolor = "white",
      xanchor = "left"
    )
  )

p <- p0 %>%
  add_bars(
    y = ~y1, name = "Primary Product",
    marker = list(color = "rgb(49,130,189)")
  ) %>%
  add_bars(
    y = ~y2, name = "Secondary Product",
    marker = list(color = "rgb(204,204,204)")
  ) %>%
  layout(
    xaxis = list(tickangle = -45),
    barmode = "group"
  )
p

自定义每个条的颜色

x <- c("Feature A", "Feature B", "Feature C", "Feature D", "Feature E")
y <- c(20, 14, 23, 25, 22)
data <- data.table(x, y)

p <- create_canvas(data = data) %>%
  add_bars(
    x = ~x, y = ~y,
    marker = list(
      color = c(
        "rgba(204,204,204,1)", "rgba(222,45,38,0.8)",
        "rgba(204,204,204,1)", "rgba(204,204,204,1)",
        "rgba(204,204,204,1)"
      )
    )
  ) %>%
  layout(
    title = list(
      text = "Least Used Features",
      pad = list(t = 40)
    )
  )
p

自定义每个条的宽度

x <- c(1, 2, 3, 5.5, 10)
y <- c(10, 8, 6, 4, 2)
width <- c(0.8, 0.8, 0.8, 3.5, 4)
data <- data.table(x, y, width)

p <- create_canvas(data = data) %>%
  add_bars(
    x = ~x,
    y = ~y,
    width = ~width
  )
p

自定义每个条的基线高度，Base

p <- create_canvas(x = c("2016", "2017", "2018")) %>%
  add_bars(
    y = c(500, 600, 700),
    base = c(-500, -600, -700),
    marker = list(
      color = "orangered"
    ),
    name = "expenses"
  ) %>%
  add_bars(
    y = c(300, 400, 700),
    # base = 0,
    marker = list(
      color = "royalblue"
    ),
    name = "revenue"
  ) %>%
  layout(
    legend = list(
      bgcolor = "white",
      xanchor = "left"
    )
  )
p

映射变量为颜色

data <- ggplot2::diamonds %>%
  count(cut, clarity)
data

#> # A tibble: 40 x 3
#>    cut   clarity     n
#>    <ord> <ord>   <int>
#>  1 Fair  I1        210
#>  2 Fair  SI2       466
#>  3 Fair  SI1       408
#>  4 Fair  VS2       261
#>  5 Fair  VS1       170
#>  6 Fair  VVS2       69
#>  7 Fair  VVS1       17
#>  8 Fair  IF          9
#>  9 Good  I1         96
#> 10 Good  SI2      1081
#> # ... with 30 more rows

p <- create_canvas(data = data) %>%
  add_bars(x = ~cut, y = ~n, color = ~clarity) %>%
  layout(
    legend = list(
      bgcolor = "white",
      xanchor = "left"
    )
  )
p

定义条间距

x <- c(
  1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
  2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
)
roW <- c(
  219, 146, 112, 127, 124, 180, 236, 207, 236,
  263, 350, 430, 474, 526, 488, 537, 500, 439
)
China <- c(
  16, 13, 10, 11, 28, 37, 43, 55, 56,
  88, 105, 156, 270, 299, 340, 403, 549, 499
)
data <- data.table(x, roW, China)

p0 <- create_canvas(data = data, x = ~x)

p <- p0 %>%
  add_bars(
    y = ~roW, name = "Rest of the World",
    marker = list(color = "rgb(55, 83, 109)")
  ) %>%
  add_bars(
    y = ~China, name = "China",
    marker = list(color = "rgb(26, 118, 255)")
  ) %>%
  layout(
    title = list(text = "US Export of Plastic Scrap"),
    xaxis = list(
      tickfont = list(
        size = 14,
        color = "rgb(107, 107, 107)"
      )
    ),
    yaxis = list(
      title = list(text = "USD (millions)"),
      titlefont = list(
        size = 16,
        color = "rgb(107, 107, 107)"
      ),
      tickfont = list(
        size = 14,
        color = "rgb(107, 107, 107)"
      )
    ),
    legend = list(
      x = 0, xanchor = "left", y = 1,
      bgcolor = "rgba(255, 255, 255, 0)" # 透明度为0
    ),
    barmode = "group", bargap = 0.15,
    bargroupgap = 0.1 # 该属性明明起作用，还是报warning说没有这个属性
  )
p

瀑布图, Waterfall

x <- c(
  "Product<br>Revenue", "Services<br>Revenue", "Total<br>Revenue",
  "Fixed<br>Costs", "Variable<br>Costs", "Total<br>Costs", "Total"
)
y <- c(400, 660, 660, 590, 400, 400, 340)
base <- c(0, 430, 0, 570, 370, 370, 0)
revenue <- c(430, 260, 690, 0, 0, 0, 0)
costs <- c(0, 0, 0, 120, 200, 320, 0)
profit <- c(0, 0, 0, 0, 0, 0, 370)
text <- c("$430K", "$260K", "$690K", "$-120K", "$-200K", "$-320K", "$370K")
data <- data.table(x, base, revenue, costs, profit, text)

# The default order will be alphabetized unless specified as below:
data$x <- factor(data$x, levels = data[["x"]])

p <- create_canvas(data = data, x = ~x) %>%
  # 堆叠层，要透明，才能看起来像什么都没有
  add_bars(
    y = ~base, name = "",
    marker = list(color = "rgba(1,1,1,0)")
  ) %>%
  add_bars(
    y = ~revenue, name = "revenue",
    marker = list(
      color = "rgba(55, 128, 191, 0.7)",
      line = list(
        color = "rgba(55, 128, 191, 0.7)",
        width = 2
      )
    )
  ) %>%
  add_bars(
    y = ~costs, name = "cost",
    marker = list(
      color = "rgba(219, 64, 82, 0.7)",
      line = list(
        color = "rgba(219, 64, 82, 1.0)",
        width = 2
      )
    )
  ) %>%
  add_bars(
    y = ~profit, name = "profit",
    marker = list(
      color = "rgba(50, 171, 96, 0.7)",
      line = list(
        color = "rgba(50, 171, 96, 1.0)",
        width = 2
      )
    )
  ) %>%
  layout(
    title = list(text = "Annual Profit - 2015"),
    barmode = "stack",
    showlegend = TRUE
  ) %>%
  add_annotations(
    text = ~text,
    x = ~x,
    y = ~y,
    xref = "x",
    yref = "y",
    font = list(
      family = "Arial",
      size = 14,
      color = "rgba(245, 246, 249, 1)"
    ),
    showarrow = FALSE
  )
p

水平条形图, Horizontal

y <- c("giraffes", "orangutans", "monkeys")
SF_Zoo <- c(20, 14, 23)
LA_Zoo <- c(12, 18, 29)
data <- data.table(y, SF_Zoo, LA_Zoo)

create_canvas(data = data) %>%
  add_bars(
    x = ~SF_Zoo,
    y = ~y,
    orientation = "h"
  )

p <- create_canvas(data = data, y = ~y, orientation = "h") %>%
  add_trace(
    x = ~SF_Zoo, name = "SF Zoo",
    marker = list(
      color = "rgba(246, 78, 139, 0.6)",
      line = list(
        color = "rgba(246, 78, 139, 1.0)",
        width = 3
      )
    )
  ) %>%
  add_trace(
    x = ~LA_Zoo, name = "LA Zoo",
    marker = list(
      color = "rgba(58, 71, 80, 0.6)",
      line = list(
        color = "rgba(58, 71, 80, 1.0)",
        width = 3
      )
    )
  ) %>%
  layout(barmode = "stack")
p

y <- c(
  "The course was effectively<br>organized",
  "The course developed my<br>abilities and skills for<br>the subject",
  "The course developed my<br>ability to think critically about<br>the subject",
  "I would recommend this<br>course to a friend"
)
x1 <- c(21, 24, 27, 29)
x2 <- c(30, 31, 26, 24)
x3 <- c(21, 19, 23, 15)
x4 <- c(16, 15, 11, 18)
x5 <- c(12, 11, 13, 14)

data <- data.table(y, x1, x2, x3, x4, x5)

top_labels <- c(
  "Strongly<br>agree", "Agree", "Neutral",
  "Disagree", "Strongly<br>disagree"
)

p0 <- create_canvas(
  data = data, y = ~y, orientation = "h",
  marker = list(line = list(
    color = "rgb(248, 248, 249)",
    width = 1
  ))
)

p <- p0 %>%
  add_bars(x = ~x1, marker = list(color = "rgba(38, 24, 74, 0.8)")) %>%
  add_bars(x = ~x2, marker = list(color = "rgba(71, 58, 131, 0.8)")) %>%
  add_bars(x = ~x3, marker = list(color = "rgba(122, 120, 168, 0.8)")) %>%
  add_bars(x = ~x4, marker = list(color = "rgba(164, 163, 204, 0.85)")) %>%
  add_bars(x = ~x5, marker = list(color = "rgba(190, 192, 213, 1)")) %>%
  layout(
    xaxis = list(
      showgrid = FALSE,
      showline = FALSE,
      showticklabels = FALSE,
      zeroline = FALSE,
      domain = c(0.15, 1) # plot 15% 的宽度空出来
    ),
    yaxis = list(
      showgrid = FALSE,
      showline = FALSE,
      showticklabels = FALSE,
      zeroline = FALSE
    ),
    barmode = "stack",
    paper_bgcolor = "rgb(248, 248, 255)",
    plot_bgcolor = "rgb(248, 248, 255)",
    margin = list(l = 120, r = 10, t = 140, b = 80),
    showlegend = FALSE
  ) %>%
  add_annotations(
    xref = "paper", x = 0.14, # plot 14% 的位置
    xanchor = "right", align = "right", # 右对齐
    yref = "y", y = ~y, # 对准y轴上的y坐标
    text = ~y,
    font = list(
      family = "Arial", size = 12,
      color = "rgb(67, 67, 67)"
    ),
    showarrow = FALSE
  ) %>%
  # labeling the percentages of each bar (x_axis)
  add_annotations(
    xref = "x", yref = "y",
    x = x1 / 2, y = y,
    text = str_c(data$x1, "%"),
    font = list(
      family = "Arial", size = 12,
      color = "rgb(248, 248, 255)"
    ),
    showarrow = FALSE
  ) %>%
  add_annotations(
    xref = "x", yref = "y",
    x = x1 + x2 / 2, y = y,
    text = str_c(data$x2, "%"),
    font = list(
      family = "Arial", size = 12,
      color = "rgb(248, 248, 255)"
    ),
    showarrow = FALSE
  ) %>%
  add_annotations(
    xref = "x", yref = "y",
    x = x1 + x2 + x3 / 2, y = y,
    text = str_c(data$x3, "%"),
    font = list(
      family = "Arial", size = 12,
      color = "rgb(248, 248, 255)"
    ),
    showarrow = FALSE
  ) %>%
  add_annotations(
    xref = "x", yref = "y",
    x = x1 + x2 + x3 + x4 / 2, y = y,
    text = str_c(data$x4, "%"),
    font = list(
      family = "Arial", size = 12,
      color = "rgb(248, 248, 255)"
    ),
    showarrow = FALSE
  ) %>%
  add_annotations(
    xref = "x", yref = "y",
    x = x1 + x2 + x3 + x4 + x5 / 2, y = y,
    text = str_c(data$x5, "%"),
    font = list(
      family = "Arial", size = 12,
      color = "rgb(248, 248, 255)"
    ),
    showarrow = FALSE
  ) %>%
  # labeling the first Likert scale (on the top)
  add_annotations(
    xref = "x", x = c(
      21 / 2, 21 + 30 / 2, 21 + 30 + 21 / 2,
      21 + 30 + 21 + 16 / 2, 21 + 30 + 21 + 16 + 12 / 2
    ),
    yref = "paper", y = 1.15,
    text = top_labels,
    font = list(
      family = "Arial", size = 12,
      color = "rgb(67, 67, 67)"
    ),
    showarrow = FALSE
  )
p

两张图合并

y <- c(
  "Japan", "United Kingdom", "Canada", "Netherlands",
  "United States", "Belgium", "Sweden", "Switzerland"
)
x_saving <- c(1.3586, 2.2623, 4.9822, 6.5097, 7.4812, 7.5133, 15.2148, 17.5205)
x_net_worth <- c(
  93453.92, 81666.57, 69889.62, 78381.53,
  141395.3, 92969.02, 66090.18, 122379.3
)
data <- data.table(y, x_saving, x_net_worth)

p1 <- create_canvas(data = data) %>%
  add_bars(
    x = ~x_saving, y = ~ reorder(y, x_saving), orientation = "h",
    name = "Household savings, percentage of household disposable income",
    marker = list(
      color = "rgba(50, 171, 96, 0.6)",
      line = list(color = "rgba(50, 171, 96, 1)", width = 1)
    )
  ) %>%
  layout(
    yaxis = list(
      showgrid = FALSE, showline = FALSE,
      showticklabels = TRUE, domain = c(0, 0.85)
    ),
    xaxis = list(
      zeroline = FALSE, showline = FALSE,
      showticklabels = TRUE, showgrid = TRUE
    )
  ) %>%
  add_annotations(
    xref = "x1", yref = "y",
    x = x_saving + 2,
    y = y,
    text = paste(round(x_saving, 2), "%"),
    font = list(family = "Arial", size = 12, color = "rgb(50, 171, 96)"),
    showarrow = FALSE
  )

p2 <- create_canvas(data = data) %>%
  add_trace(
    x = ~x_net_worth, y = ~ reorder(y, x_saving),
    name = "Household net worth, Million USD/capita",
    type = "scatter", mode = "lines+markers",
    line = list(color = "rgb(128, 0, 128)")
  ) %>%
  layout(
    yaxis = list(
      showgrid = FALSE, showline = TRUE, showticklabels = FALSE,
      linecolor = "rgba(102, 102, 102, 0.8)", linewidth = 2,
      domain = c(0, 0.85)
    ),
    xaxis = list(
      zeroline = FALSE, showline = FALSE, showticklabels = TRUE,
      showgrid = TRUE, side = "top", dtick = 25000
    )
  ) %>%
  add_annotations(
    xref = "x2", yref = "y",
    x = x_net_worth, y = y,
    text = paste(x_net_worth, "M"),
    font = list(family = "Arial", size = 12, color = "rgb(128, 0, 128)"),
    showarrow = FALSE
  )

p <- subplot(p1, p2) %>%
  layout(
    title = list(text = "Household savings & net worth for eight OECD countries"),
    legend = list(x = 0.029, xanchor = "left", y = 1.038, font = list(size = 10)),
    margin = list(l = 100, r = 20, t = 70, b = 110),
    paper_bgcolor = "rgb(248, 248, 255)",
    plot_bgcolor = "rgb(248, 248, 255)"
  ) %>%
  add_annotations(
    xref = "paper", yref = "paper",
    x = -0.14, y = -0.15,
    text = paste("OECD (2015), Household savings (indicator), Household net worth (indicator). doi: 10.1787/cfc6f499-en (Accessed on 05 June 2015)"),
    font = list(family = "Arial", size = 10, color = "rgb(150,150,150)"),
    showarrow = FALSE
  )
p